EXERCISE:

Apply PDP to the regression example of predicting bike rentals. Fit a random forest approximation for the prediction of bike rentals (cnt). Use the partial dependence plot to visualize the relationships the model learned. Use the slides shown in class as model.

QUESTION:

Analyse the influence of days since 2011, temperature, humidity and wind speed on the predicted bike counts.

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(plotly)
## Loading required package: ggplot2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(reshape2)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(randomForestSRC)
## Warning: package 'randomForestSRC' was built under R version 4.1.3
## 
##  randomForestSRC 3.1.0 
##  
##  Type rfsrc.news() to see new features, changes, and bug fixes. 
## 
#setwd("Practica 3/Bike-Sharing-Dataset")
days <- read.csv("day.csv")
hour <- read.csv("hour.csv")

days$dteday <- as_date(days$dteday)
days_since <- select(days, workingday, holiday, temp, hum, windspeed, cnt)
days_since$days_since_2011 <- int_length(interval(ymd("2011-01-01"), days$dteday)) / (3600*24)
days_since$SUMMER <- ifelse(days$season == 3, 1, 0)
days_since$FALL <- ifelse(days$season == 4, 1, 0)
days_since$WINTER <- ifelse(days$season == 1, 1, 0)
days_since$MISTY <- ifelse(days$weathersit == 2, 1, 0)
days_since$RAIN <- ifelse(days$weathersit == 3 | days$weathersit == 4, 1, 0)
days_since$temp <- days_since$temp * 47 - 8
days_since$hum <- days_since$hum * 100
days_since$windspeed <- days_since$windspeed * 67

rf <- rfsrc(cnt~., data=days_since)

results <- select(days_since, days_since_2011, temp, hum, windspeed, cnt)
nr <- nrow(days_since)
for(c in names(results)[1:4])
{
  for(i in 1:nr){
    r <- days_since
    r[[c]] <- days_since[[c]][i]
    sal <- predict(rf, r)$predicted
    results[[c]][i] <- sum(sal) / nr
  }
}
p1 <- ggplot(days_since, aes(x=days_since_2011, y=results$days_since_2011)) + geom_line() +ylim(c(0,6000))+ geom_rug(alpha = 0.1, sides = "b") + ylab("Prediction") + xlab("Days since 2011")
p2 <- ggplot(days_since, aes(x=temp, y=results$temp)) + geom_line() +ylim(c(0,6000))+ geom_rug(alpha = 0.1, sides = "b")+ xlab("Temperature")
p3 <- ggplot(days_since, aes(x=hum, y=results$hum)) + geom_line() +ylim(c(0,6000))+ geom_rug(alpha = 0.1, sides = "b")+ xlab("Humidity")
p4 <- ggplot(days_since, aes(x=windspeed, y=results$windspeed)) + geom_line() +ylim(c(0,6000))+ geom_rug(alpha = 0.1, sides = "b")+ xlab("Wind speed")
subplot(p1,p2,p3,p4, shareY = TRUE, shareX = FALSE, titleX = TRUE)

Como podemos observar en los gráficos, el alquiler de bicicletas aumenta conforme más dias pasan desde 2011 aunque, cuando pasan 600 dias vuelve a disminuir de nuevo. En cuento a la temperatura, observamos que el número de bicicletas alquiladas aumenta cuando la temperatura se encuentra entre los 15 y 25 grados, mientras que por el contrario disminuye cuando las temperaturas son inferiores a los 15 grados. Por otro lado, cuando aumenta la humedad, disminuye el número de bicicletas alquiladas. Finalemente, cuando aumenta la velocidad del viento disminuye ligeramente el número de bicicletas alquiladas.

EXERCISE:

Generate a 2D Partial Dependency Plot with humidity and temperature to predict the number of bikes rented depending of those parameters.

BE CAREFUL: due to the size, extract a set of random samples from the BBDD before generating the the data for the Partial Dependency Plot.

Show the density distribution of both input features with the 2D plot as shown in the class slides.

TIP: Use geom_tile() to generate the 2D plot. Set width and height to avoid holes.

sampled <- sample_n(days_since, 40)
temp <- sampled$temp
hum <- sampled$hum
th <- inner_join(data.frame(temp),data.frame(hum), by=character())
th$p <- 0

for(i in 1:nrow(th)){
r <- days_since
r[["temp"]] <- th[["temp"]][i]
r[["hum"]] <- th[["hum"]][i]
sal <- predict(rf, r)$predicted
th[["p"]][i] <- sum(sal) / nr
}

ggplot(th, aes(x=temp, y=hum)) + geom_tile(aes(fill = p, width = 10, height = 15)) + geom_rug(alpha = 0.02) + xlab("Temperature") + ylab("Humidity") + scale_fill_gradient(name = "Number of bikes")

QUESTION:

Observando el gráfico de dependencia parcial, observamos que el número de bicicletas alquiladas aumenta cuando la humedad está por debao de 60 y la temperatura se encuentra entre 13 y los 28 grados. Por el contrario, cuando la temperatura es inferior a 9 grados y la humedad está por encima de los 80, se alquilan menos de 3000 bicicletas.

EXERCISE:

Apply the previous concepts to predict the price of a house from the database kc_house_data.csv. In this case, use again a random forest approximation for the prediction based on the features bedrooms, bathrooms, sqft_living, sqft_lot, floors and yr_built. Use the partial dependence plot to visualize the relationships the model learned.

BE CAREFUL: due to the size, extract a set of random samples from the BBDD before generating the data for the Partial Dependency Plot.

QUESTION:

Analyse the influence of bedrooms, bathrooms, sqft_living and floors on the predicted price.

d <- read.csv("kc_house_data.csv")

sampled <- sample_n(d, 40) # 40 por que tardaba mucho

sampled <- select(sampled, bedrooms, bathrooms, sqft_living, sqft_lot, floors, yr_built, price)

rf <- rfsrc(price~., data=sampled)

results <- select(sampled, bedrooms, bathrooms, sqft_living, floors, price)
nr <- nrow(sampled)
for(c in names(results)[1:4])
{
  for(i in 1:nr){
    r <- sampled
    r[[c]] <- sampled[[c]][i]
    sal <- predict(rf, r)$predicted
    results[[c]][i] <- sum(sal) / nr
  }
}
p1 <- ggplot(sampled, aes(x=bedrooms, y=results$bedrooms)) + geom_line() + geom_rug(alpha = 0.1, sides = "b") + ylab("Prediction") + xlab("Bedrooms")
p2 <- ggplot(sampled, aes(x=bathrooms, y=results$bathrooms)) + geom_line() + geom_rug(alpha = 0.1, sides = "b")+ xlab("Bathrooms")
p3 <- ggplot(sampled, aes(x=sqft_living, y=results$sqft_living)) + geom_line() + geom_rug(alpha = 0.1, sides = "b")+ xlab("Sqft Living")
p4 <- ggplot(sampled, aes(x=floors, y=results$floors)) + geom_line() + geom_rug(alpha = 0.1, sides = "b")+ xlab("Floors")
subplot(p1,p2,p3,p4, shareX = FALSE, titleX = TRUE)

Como podemos observar en los gráficos, cuando el número de habitaciones aumenta, el precio predicho de la vivienda también aumenta siendo el máximo precio predicho cuando la vivienda tiene 4 dormiorios. Aunque, cuando la vivienda tiene 5 dormitorios el precio predicho vuelve a disminuir pero la cantidad de datos de viviendas con 5 dormitorios es baja.

Por otro lado, observamos que cuando el número de baños aumenta, el precio predicho de la vivienda también lo hace.

Además, en el siguiente gráfico también podemos observar que cuando aumentan los metros cuadrados del apartamento también aumenta el precio del mismo.

Finalmente, cuando aumenta el número de pisos de la vivienda también aumenta el precio predicho de la misma.